If Right$(UCase$(TxtFrmName.Text), 4) <> ".FRM" Then
TxtFrmName.Text = TxtFrmName.Text & ".FRM"
End If
sForm = TxtFrmName.Text
If stemplate = "" Then
Beep
mousepointer = DEFAULT
MsgBox "You must specify a form template or use the file drawer button to locate a form template.", 0 + 48 + 0 + 0, "Form Template Error"
TxtTmpltName.SetFocus
Exit Sub
End If
If Dir$(stemplate) = "" Then
Beep
mousepointer = DEFAULT
MsgBox "The form template you have specified does not exist! Use the file drawer button to locate a form template.", 0 + 48 + 0 + 0, "Form Template Error"
TxtTmpltName.SetFocus
Exit Sub
End If
If sForm = "" Then
Beep
mousepointer = DEFAULT
MsgBox "You must specify a form name or use the file drawer button to locate a form.", 0 + 48 + 0 + 0, "Form Save Error"
TxtFrmName.SetFocus
Exit Sub
End If
If sForm = stemplate Then
Beep
mousepointer = DEFAULT
MsgBox "You cannot use the template as the output form.", 0 + 48 + 0 + 0, "Form Save Error"
TxtFrmName.SetFocus
Exit Sub
End If
On Error GoTo erropeningtemplate
Open stemplate For Input Access Read Lock Write As #1
On Error GoTo erropeningform
Open sForm For Output Access Write Lock Read Write As #2
On Error GoTo GenerateErr
indent = 0
Do While Not EOF(1)
sFormLine = ""
Do
Char = Input$(1, #1)
sFormLine = sFormLine + Char
Loop While Char <> Chr$(10)
sFormLine = Left$(sFormLine, Len(sFormLine) - 2)
Select Case True
Case InStr(1, sFormLine, "Begin Form", 1) <> 0 ' Beginning of form
Print #2, "Begin Form " & DataForm.TxtFormName.Text
indent = 3
Case InStr(1, sFormLine, "Caption", 1) <> 0 ' Form Caption line
MsgBox "The database name you have specified does not exist! Use the file drawer button to locate a database.", 0 + 48 + 0 + 0, "Database Selection Error"
TxtDBName.SetFocus
mousepointer = DEFAULT
Exit Sub
End If
LstRecSrce.Clear
Set db = OpenDatabase(TxtDBName.Text)
On Error GoTo GetTablesErr
Set sstables = db.ListTables()
Do While Not sstables.EOF
If sstables!Attributes And DB_SYSTEMOBJECT Then
Else
LstRecSrce.AddItem sstables!Name
End If
sstables.MoveNext
Loop
sstables.Close
LstRecSrce.ListIndex = 0
Mid(RequiredFieldsComplete, 1, 1) = "Y"
Call SetFinishBtn
mousepointer = DEFAULT
Exit Sub
OpenDBErr:
Beep
mousepointer = DEFAULT
msg = "A " & Error & " error has occurred opening the database! Please correct and retry the function"
